package Zim;

use strict;
use Carp;
use UNIVERSAL qw/isa/;
use File::Spec;
use File::BaseDir qw/
	xdg_config_home xdg_config_files
	xdg_data_home xdg_data_dirs xdg_data_files/;
use Zim::Store;
use Zim::Selection;
use Zim::History;
use Zim::File;
use Zim::Page;

our $VERSION = '0.20';
our $COPYRIGHT = 'Copyright (c) 2005,2007 Jaap G Karssenberg.';
our $LONG_VERSION = << "EOT";
zim $VERSION - A desktop wiki and outliner

$COPYRIGHT All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

Please report bugs to pardus\@cpan.org
EOT
our $AUTHORS = 'Jaap Karssenberg <pardus@cpan.org>';
our $WEBSITE = 'http://www.pardus.nl/projects/zim';

=head1 NAME

Zim - Application object for the zim desktop wiki

=head1 SYNOPSIS

	use Zim;
	
	my $repo = Zim->new(
		type     => 'Files',
		dir      => $dir,
	);
	my $page = $repo->get_page('Home');

=head1 DESCRIPTION

This class defines the public interface to the document repository
as used by L<zim>(1). It acts as a dispatcher that manages one or
more store objects to handle page requests. It also adds some tests
and thus tries to isolate the stores from errors in the GUI.

The interface which child objects should support is defined in
L<Zim::Store>.

=head1 METHODS

=head2 Public Methods

The following methods can be used by the GUI.

=over 4

=item new(PARENT, NAMESPACE, FILE)

=item new(PARENT, NAMESPACE, DIR, TYPE, ...)

Constructor. PARENT can be a parent repository object or undef.
NAMESPACE is the prefix for all pages managed by this repository.

TODO: implement this: FILE should be the path to a repository config file.

DIR is the root namespace of the repository and might contain
a onfig file.

TYPE is optional and is used to initialize a top level child
repository when no other config is given. This is used for example
to intialize a repository. All remaining arguments are passed on
to this top level child repository.

=cut

sub new {
	my ($class, %param) = @_;

	$param{namespace} ||= ':';
	$param{namespace} =~ s/:?$/:/;
	die "BUG: repository initialized without directory"
		unless $param{dir};
	$param{dir} = Zim::File->abs_path($param{dir});
	die "Not a directory: $param{dir}\n"
		if -e $param{dir} and ! -d $param{dir};
	
	my $self = bless {%param}, $class;
	$self->{config} ||= {};
	
	# Find config
	my ($conf) = grep $_->exists(),
	             map  Zim::File->new($param{dir}, $_),
		     qw/_zim.config .zim.config/;
	$conf ||= Zim::File->new($param{dir}, '.zim.config');
	$self->{conf_file} = $conf;

	# Read config
	$conf->read_config( $self->{config} );
	for my $ns (grep /^:/, keys %{$self->{config}}) {
		# remove namespace defnitions from config
		# allows lines like ":namespace=Class,key=val,key=val"
		my $val = delete $self->{config}{$ns};
		my ($class, $arg) = split ',', $val, 2;
		my %arg = map split('=',$_,2),
		          map split(',',$_,2), $arg; 
		$self->add_child($ns => $class, %arg);
	}
	
	# Set default store if not yet defined
	my $type = $self->{type} || 'Files';
	$self->add_child(':', $type, %param)
		unless defined $self->{':'};
	$self->{':'}{indexpage} = $self->{config}{home} || '';

	return $self;	
}

=item C<init_history()>

Initializes a L<Zim::History> to be used with this repository.
Returns the history object or undef.

=cut

sub init_history {
	my $self = shift;

	my $hfile = $self->{config}{hist_file};
	unless ($hfile) { # default hist file
		$hfile = Zim::File->abs_path(
			$self->{dir}.'/.zim.history.cache');
		$hfile = Zim::File->cache_path($hfile)
			if -e $self->{dir} and ! -w $self->{dir};
	}
	
	my $hdir = Zim::File->dir($hfile);
	$hfile = undef
		if (-e $hfile and ! -w $hfile)
		or (-e $hdir  and ! -w $hdir ) ;
	warn "# History file: $hfile\n";
	my $max = $self->{config}{hist_max} || 15;
	eval {
		$self->{history} ||= Zim::History->new($hfile, $max, undef);
	};
	warn $@ if $@;
	
	return $self->{history};
}

=item C<add_child(NAMESPACE, CHILD, ...)>

This will connect a new child object to this repository under a certain
namespace. CHILD is a class name implementing the repository interface.
The class will be looked for in C<Zim::Store::>.
All remaining arguments will be passed on to the constructor of the object.

=cut

sub add_child {
	my ($self, $namespace, $child, %args) = @_;
	$namespace =~ s/:?$/:/;
	_check_namespace($namespace);
	warn "# Adding store of type '$child' at '$namespace'\n";
	$args{namespace} = $namespace;

	my $class = "Zim::Store::" .
		join('::', map quotemeta($_), split '::', $child);
	eval "use $class ();";
	die "While loading store '$child':\n".$@ if $@;
	my $obj = $class->new(parent => $self, %args);

	$namespace =~ s/:*$//;
		# strip last ":" because we also want the page
		# of the same name as the namespace to resolve to this
		# child, this page is known as the "indexpage"
	$namespace ||= ':';
	$self->{lc($namespace)} = $obj;

	my $ns = $self->{namespace};
	$ns =~ s/:*$//;
	my $regex = join '|', map quotemeta($_),
		sort {length($b) <=> length($a)} grep /^:./, keys %$self;
	$regex = length($regex) ? "(?:$regex)(?![^:])|:" : ':';
	$self->{regex} = qr#^(?i)\Q$ns\E($regex)#;
	#warn "regex: $self->{regex}\n";
}

=item C<config()>

Returns a hash with config options.

=cut

sub config { $_[0]->{config} }

=item C<save()>

Save config, history, etc. to disk.

=cut

sub save {
	# Need to merge config with definition for stores
	my $self = shift;
	my $file = Zim::File->new($self->{conf_file});
	my $conf = $file->read_config;
	! /^:/ && delete $$conf{$_} for keys %$conf;
	$$conf{$_} = $$self{config}{$_} for keys %{$$self{config}};
	$file->write_config($conf);
	$self->{history}->write if $self->{history};
}

=item C<root()>

Returns self.

=cut

sub root { return $_[0] }

=item C<base()>

Returns the base directory for files.

The "base" directories for individual pages should either be the same as
this directory or a subdirectory of it.

=cut

sub base { return $_[0]->{dir} }

## 3 methods for checking arguments ##

sub _check_page {
	if (ref $_[0]) {
		croak "Object \"$_[0]\" is not a Zim::Page"
	       		unless isa $_[0], 'Zim::Page';
	}
	elsif ($_[1]) { croak "\"$_[0]\" is not a page object" }
	else { goto \&_check_page_name }
}

# Valid page names can contain letters, numbers and ".", "-", "(" and ")"
# The first character of a name can only be a letter or a number
# Absolute names start with a ":"
# Namespaces end in a ":"

sub _check_page_name {
	croak "\"$_[0]\" is not a valid page name"
		unless $_[0] =~ /^(?::+[\w\%]+[\w\.\-\(\)\%]*)+$/;
}

sub _check_namespace {
	croak "\"$_[0]\" is not a valid namespace"
		unless $_[0] =~ /^(?::+|(?::+[\w\%][\w\.\-\(\)\%]*)+:+)$/;
}

=item C<list_pages(NAMESPACE)>

Lists pages in NAMESPACE. Sub-namespaces have a trailing ':'
in the listing.

If a page is not present in this list that does not mean that it
doesn't exists. This list is used for hierarchical views of the
page structure; not all repositories need to support a hierarchical order.

=cut

sub list_pages {
	my ($self, $namespace) = @_;
	$namespace =~ s/:?$/:/;
	_check_namespace($namespace);
	
	# List stores in this namespace
	my @pages =
		grep { m/^:/ and s/^\Q$namespace\E:*([^:]+:*)$/$1:/ } keys %$self;
	@pages = map { s/.*://; $_ } map $self->{$_}{namespace}, @pages;

	# List pages from the store managing this namespace
	$namespace =~ $self->{regex}
		or die "BUG: '$namespace' !~ qr/$self->{regex}/";
	return if $self->{lc($1)}->{no_show_in_sidepane}; # temp HACK
	@pages = sort @pages, $self->{lc($1)}->list_pages($namespace);

	# remove doubles
	for (0 .. $#pages-1) {
		$pages[$_] = undef if $pages[$_+1] eq $pages[$_];
		$pages[$_] = undef if $pages[$_+1] eq $pages[$_].':';
	}

	return sort {lc($a) cmp lc($b)} grep defined($_), @pages;
}

=item get_page(NAME)

Returns an object of a class inheriting from L<Zim::Page>.
When you ask for a page that doesn't exists yet, you should get a new object.
In case it is not possible to create the page in question C<undef> is returned.

=cut

sub get_page {
	my ($self, $name) = @_;
	_check_page_name($name);
	$name =~ $self->{regex} or die "BUG: '$name' !~ qr/$self->{regex}/";
	#warn "'$name' =~ /$self->{regex}/ => \$1 = '$1'\n";
	#warn "Dispatching get_page('$name') to '".lc($1)."'\n";
	return $self->{lc($1)}->get_page($name);
}

=item C<resolve_page(LINK, PAGE, NO_DEFAULT)>

Like C<get_page()> but now expecting NAME to be user input,
so NAME is sanitized first.

=cut

sub resolve_page {
	my $self = shift;
	my $name = $self->resolve_name(@_);
	return $name ? $self->get_page($name) : undef ;
}

=item C<resolve_name(LINK, PAGE, REFERENCE, NO_DEFAULT)>

Cleans up NAME but does not actually fetch a page object.

=cut

sub resolve_name {
	my ($self, $name, $ref, $no_def) = @_;
	#warn "!! resolve name: @_\n";
	if ($ref) {
		# TODO check for multiple children in path
		# TODO use child path case for path
		$name = Zim::Store->clean_name($name, 1) or return;
		$ref =~ $self->{regex}
			or die "BUG: '$ref' !~ qr/$self->{regex}/";
		#warn "!! dispatch to: $1\n";
		return $self->{lc($1)}->resolve_name($name, $ref, $no_def);
	}
	else {
		$name = Zim::Store->clean_name($name, 0) or return;
		$name =~ $self->{regex}
			or die "BUG: '$name' !~ qr/$self->{regex}/";
		my $child = $1;
		$name =~ s/^$child/$child/i; # set correct caps
		#warn "!! dispatch to: $1\n";
		return $self->{lc($child)}->resolve_name($name, undef, $no_def);
	}
}

=item C<resolve_namespace(NAME)>

Returns a namespace string. Used to sanitize user input.

=cut

sub resolve_namespace {
	my ($self, $name) = @_;
	$name = Zim::Store->clean_name($name);
	$name .= ':'; 	# is a namespace
	$name =~ $self->{regex} or die "BUG: '$name' !~ qr/$self->{regex}/";
	my $child = $1;
	$name =~ s/^$child/$child/i; # set correct caps
	return $name;
}

=item copy_page(SOURCE, TARGET, UPDATE_LINKS)

Copy page SOURCE to TARGET. Both arguments can be either page names
or objects. Returns the (new) TARGET object. The UPDATE_LINKS argument
is a boolean that tells whether links to this page should be updated
to point to this new name.

=item move_page(SOURCE, TARGET, UPDATE_LINKS)

Move page SOURCE to TARGET. Both arguments can be either page names
or objects. Returns the (new) TARGET object.The UPDATE_LINKS argument
is a boolean that tells whether links to this page should be updated
to point to this new name.

=cut

sub copy_page { _clone('copy_page', @_) }

sub move_page { _clone('move_page', @_) }

sub _clone { # Copy and move are almost the same
	my ($method, $self, $source, $target, $update) = @_;
	_check_page($source);
	_check_page($target);
	
	$source = $self->get_page($source) || die "Could not open page '$source'\n"
		unless ref $source;
	$target = $self->get_page($target) || die "Could not create page '$target'\n"
	       	unless ref $target;
	
	die "BUG: You tried to move a page marked as read-only\n"
		if $method eq 'move_page' and $source->{properties}{read_only};
	die "Page '$target' exists\n"
		if $target->exists and ! $target->equals($source);
		# if pages are equal the case can still differ
	
	if ($source->{store} eq $target->{store}
		and $target->{store} ne $self
	) {
		$source->{store}->$method($source, $target, $update);
	}
	else {
		$target->clone($source);
		if ($update) {
			my ($from, $to) = ($source->name, $target->name);
			$self->get_page($_)->update_links($from => $to)
				for $source->list_backlinks ;
		}
		$source->{store}->delete_page($source)
			if $method eq 'move_page';
	}

	return $target;
}

=item delete_page(PAGE)

Delete PAGE. PAGE can be either a page name or a page object.

=cut

sub delete_page {
	my ($self, $page) = @_;
	_check_page($page);
	$page = $self->get_page($page) unless ref $page;
	die "BUG: You tried to delete a page marked as read-only\n"
		if $page->{properties}{read_only};
	if ($page->{store} eq $self) {
		$page->status('deleted');
	}
	else {
		$page->{store}->delete_page($page);
	}
	return $page;
}

=item C<list_backlinks(PAGE)>

Returns a list of links to this page.

=cut

sub list_backlinks {
	my ($self, $page) = @_;
	_check_page($page);
	my @backlinks;
	for (grep /^:/, keys %$self) {
		push @backlinks, $self->{$_}->list_backlinks($page)
			if $self->{$_}->can('list_backlinks');
	}
	return @backlinks;
}

=item C<search(QUERY, CALLBACK)>

TODO stable api for this using Zim::Selection

Results are given as arguments to CALLBACK in the form C<[PAGE, SCORE]>.

=cut

# We could probably use some kind of "query" object that coordinates searches
# on subsets of pages  and combines backlink lists with other keywords

sub search {
	my ($self, $query, $callback) = @_;
	for (grep /^:/, keys %$self) {
		$self->{$_}->_search($query, $callback)
			if $self->{$_}->can('_search');
	}
}

=item C<interwiki_lookup(KEY, PAGE)>

Returns an url for an interwiki link with interwiki name KEY and page PAGE.
Lookup for names is case in-sensitive.

=cut

our %_urls;

sub interwiki_lookup {
	my ($class, $key, $page) = @_;
	$key = lc $key;
	my $url;
	if (exists $_urls{$key}) { $url = $_urls{$key} }
	else { # file lookup
		# TODO repository specific urls here
		
		# Lookup named zim repositories
		my $dir = $class->get_repository($key);
		if (defined $dir) {
			$url = Zim::File->path2uri($dir);
			$url =~ s#^file:#zim:#i;
			$url .= '?{NAME}';
		}

		# lookup interwiki config
		unless (length $url) {
			for (xdg_data_files(qw/zim urls.list/)) {
				$url = Zim::File->new($_)->read_hash($key);
				last if defined $url;
			}
		}
	}
	return unless length $url;
	$_urls{lc($key)} = $url;

	unless ($url =~ s/{NAME}/$page/) {
		$page =~ s/([^A-Za-z0-9\-_.!~*'()])/sprintf("%%%02X", ord($1))/ge;
		$url =~ s/{URL}/$page/ or $url .= $page;
	}
	
	return $url;
}

=item C<get_history()>

Return a object of class L<Zim::History> or undef.

=cut

sub get_history { $_[0]{history} }

####

sub _flush_cache { # TODO TODO good API for this
	my $self = shift;
	for (grep /^:/, keys %$self) {
		$self->{$_}->_flush_cache
			if $self->{$_}->can('_flush_cache');
	}
}

=back

=head2 Class Methods

These methods can be called as C<< Zim->method(...) >>.

=over 4

=item C<list_repositories()>

Returns a reference to a list with names for known repositories.

TODO needs some kind of pseud-hash like object :)

=cut

sub list_repositories {
	my $class = shift;
	my (undef, $list) = _read_rep_list() or return ();
	@$list = grep {! /^_/} @$list;
	return $list;
}

=item C<set_default_repository(REPOSITORY)>

Set the path or name for the default repository.

=item C<get_default_repository()>

Returns the path for the default repository, if there is one.

=cut

sub set_default_repository { $_[0]->set_repository(_default_ => $_[1]) }

sub get_default_repository {
	my $class = shift;
	my $def = $class->get_repository('_default_') or return undef;
	return $def if $def =~ /[\/\\]/;
	return $class->get_repository($def);
}

=item C<set_repository(NAME => PATH)>

Set the name for a repository.

=item C<get_repository(NAME)>

Returns a path for a repository with NAME or undef if the repository is unknown.
The lookup is case in-sensitive.

=cut

sub set_repository {
	my ($class, $name, $path) = @_;
	my ($hash, $list) = _read_rep_list();
	$hash ||= {};
	$list ||= [];
	die "TODO";
}

sub get_repository {
	my ($class, $name) = @_;
	my ($hash) = _read_rep_list() or return undef;
	($name) = grep {lc($_) eq lc($name)} keys %$hash
		unless exists $$hash{$name};
	return $name ? $$hash{$name} : undef;
}

sub _read_rep_list {
	my ($file) = xdg_config_files('zim', 'repositories.list');
	return () unless defined $file;
	return Zim::File->new($file)->read_config;
}


1;

__END__

=back

=head1 BUGS

Please mail the author if you find any bugs.

=head1 AUTHOR

Jaap Karssenberg || Pardus [Larus] E<lt>pardus@cpan.orgE<gt>

Copyright (c) 2005 Jaap G Karssenberg. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<zim(1)>,
L<Zim::Store>

=cut
